-- stack: in.8
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 3
-- first background id: 2765
-- card count: 16
-- first card id: 2966
-- list block id: 12092
-- print block id: 9282
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 69920 bytes
-- stack block size: 11776 bytes
-- created by hypercard version: 0x00000000
-- compacted by hypercard version: 0x01228000
-- modified by hypercard version: 0x01228000
-- opened by hypercard version: 0x01228000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
on ftype fname,num
  get number of lines of cd fld fname
  if it <num+1 then
    set style of cd fld fname to rectangle
  else
    set style of cd fld fname to scrolling
    set scroll of cd fld fname to 0
  end if
end ftype

on openStack
  global force,intl,total
  if the version < "1.2" then
    Ask "This stack requires HyperCard 1.2.1 or newer" with "Drat!"
    go recent cd
  end if
  go cd 1
  put false into total
  put empty into intl
  set lockscreen to true
  set lockmessages to true
  push cd
  go second cd
  if number of cd flds >0 then put true into total
  pop cd
  set lockscreen to false
  set lockmessages to false
  put false into force
  hide message box
  put the seconds/86400 + 16480.5 + DSTCheck()/24 into jd2
  put trunc(jd2+24000000) +1 into jd
  get the long date
  if first word of cd fld daily is not in it then
    beep
    put "Polynomials are outdated..."
    wait 1 sec
    hide message box
  end if
  put "Dimanche,Lundi,Mardi,Mercredi,Jeudi,Vendredi,Samedi" into frdays
  if first word of it is in frdays then put "Fr" into intl
  get the date
  if it contains "." then put "De" into intl
  convert it to dateItems
  if intl = "De" then
    repeat with i=1 to number of chars of it
      if char i of it = "." then put "," into char i of it
    end repeat
    put item 1 of it into d
    put item 2 of it into m
  else if intl = "Fr" then
    put item 2 of it into d
    put item 3 of it into m
  else
    put item 2 of it into m
    put item 3 of it into d
  end if
  put false into val
  if intl is empty then
    if m>4 and m<=10 then put true into val
    put trunc(jd-7*trunc(jd/7)) into w
    if m=4 and d>=w-1 then put true into val
    if m=10 and (d-w)>=25 then put false into val
    set hilite of bkgnd button "DST" of cd origin to val
    if val then
      put "D" into char 3 of last word of cd fld coords of cd origin
    else
      put "S" into char 3 of last word of cd fld coords of cd origin
    end if
  end if
  push cd
  if the short name of this cd is "origin" then
    put line 2 of cd fld "Algol" into ecl
    repeat
      if ecl > jd2 then exit repeat
      add 2.8673075 to ecl
    end repeat
    set numberFormat to "0.0"
    put "Next minimum of Algol occurs in" && (ecl-jd2)*24 && "hours at JD=" into line 1 of cd fld Algol
    set numberFormat to "0.###"
    put ecl+2400000 after line 1 of cd fld Algol
    put ecl into line 2 of cd fld Algol
  end if
end openStack

function nDate Uflag,Jflag,n
-- Uflag =0 for no UT, 1 for UT
-- Jflag =12 for JT, 0 for no JT
-- n = # days after given date
global intl
get the seconds
add 86400*n+3600*(Jflag+Uflag*DSTcheck()) to it
convert it to long date
if intl = "De" then
  put char 1 to (offset(".",second word of it)-1) of second word of it && third word of it && last word of it into he
else if intl = "Fr" then
  put second word of it && third word of it && last word of it into he
else
  put char 1 to (offset(",",third word of it)-1) of third word of it && second word of it && last word of it into he
end if
return he
end nDate

function rnd10 x
return round(x*10)/10
end rnd10

function DSTcheck
get first word of line 4 of cd fld Coords of cd origin
if hilite of bkgnd button "DST" of cd origin
then put it-1 into temp
else put it into temp
return temp
end DSTcheck

function frac x
return x-trunc(x)
end frac

function sgn x
if x<0 then
  get -1
else if x=0 then
  get 0
else if x>0 then
  get 1
end if
return it
end sgn

function sind n
return sin((n mod 360)*pi/180)
end sind

function cosd n
return cos((n mod 360)*pi/180)
end cosd

function tand n
return tan((n mod 360)*pi/180)
end tand

on dayOfYear
  -- returns day, dayUT as number of day in year
  global dayUT,day,daySecs,intl
  put the date into daysecs
  if intl is "De" then
    repeat with i=1 to number of chars of daysecs
      if char i of daysecs = "." then put "/" into char i of daysecs
    end repeat
  end if
  put number of chars of the date into ndate
  if intl is "Fr" then
    -- swap months and days of daysecs
    put 0 into j
    repeat with i=1 to number of chars of daysecs
      if char i of daysecs = "/" then
        add 1 to j
        put i into item j of pos
      end if
    end repeat
    put item 1 of pos into c1
    put item 2 of pos into c2
    put char 1 to c1-1 of daysecs into i
    put char c1+1 to c2-1 of daysecs into j
    put char c2+1 to (number of chars of daysecs) of daysecs into k
    put j&"/"&i&"/"&k into daysecs
  end if
  put "12/31/" & (char ndate-1 to ndate of the date)-1 into Jan0
  convert daySecs to seconds
  convert Jan0 to seconds
  put (daySecs-Jan0)/86400 into day
  put (daySecs-Jan0+3600*DSTcheck())/86400 into dayUT
  if intl is "Fr" then put "day = "&&day
end dayOfYear

on cheb a,b,c
  global x,xa,xb
  put 2*x*a-b+c into temp
  put a into xb
  put temp into xa
end cheb

on UT
  global day,daySecs,x,xa,xb,m
  dayOfYear -- gets daySecs
  get ((the seconds-daySecs)/3600+DSTcheck())mod 24
  put trunc(it) into h
  put trunc(60*(it-h)) into m
  if m<10 then put "0" before m
  if h=0 then put "0" before h
  put "Universal Time = "& h &":" & m into line 1 of fld UT
  put it into line 2 of fld UT
end UT

on ST
  global day,daySecs,x,xa,xb,dayUT
  dayOfYear -- gets day
  put (dayUT-1)/183-1 into x
  put 0 into a
  put 0 into b
  put 7 into i
  repeat until i=0
    cheb a,b,word i+1 of cd fld "Sidereal Cheb" of cd origin
    put xa into a
    put xb into b
    subtract 1 from i
  end repeat
  put xb into b2
  cheb a,b,word 1 of cd fld "Sidereal Cheb" of cd origin
  get ((xa-b2)/2+((the seconds-daySecs)/3600+DSTcheck())*1.00273791+ (line 2 of cd fld "coords" of cd origin)/15+24) mod 24
  put trunc(it) into h
  put trunc(60*(it-h)) into m
  if m<10 then put "0" before m
  if h=0 then put "0" before h
  put "Sidereal Time = "& h &":" & m into line 1 of fld ST
  put it into line 2 of fld ST
end ST

on hm decv,arg
  global h,m
  put trunc(arg) into h
  put trunc(60*(arg-h)) into m
  if decv then put abs(m) into m
  if m<10 then put "0" before m
end hm

function atanq x,y
get atan(y/x)
if x>0 then add pi to it
return it mod (2*pi)
end atanq

on moonpos
  global t,dra,decra,dec,fac
  set cursor to busy
  put 218.32+481267.883*t+6.29*sind(134.9+477198.85*t)-1.27* sind(259.2-413335.38*t)+.66*sind(235.7+890534.23*t)+.21*sind( 269.9+954397.7*t)-.19*sind(357.5+35999.05*t)-.11*sind(186.6+ 966404.05*t) into lambda
  put 5.13*sind(93.3+483202.03*t)+.28*sind(228.2+960400.87*t) -.28*sind(318.3+6003.18*t)-.17*sind(217.6-407332.2*t) into beta
  put cosd(beta)*cosd(lambda) into l
  set cursor to busy
  put .9175*cosd(beta)*sind(lambda)-.3978*sind(beta) into m
  put .3978*cosd(beta)*sind(lambda)+.9175*sind(beta) into n
  put (180+atanq(l,m)/fac) mod 360 into dra
  put dra/15 into decra
  put atan(n/sqrt(1-n*n))/fac into dec
end moonpos

on calc num,force
  global day,daySecs,x,xa,xb,dayUT,it,h,m,mode,t,dec,decra,dra,fac
  -- calcs ra and dec, force =true means do it anyway
  set cursor to 1001
  dayOfYear -- gets day,dayUT
  put pi/180 into fac
  get line 3 of fld UT
  put line 1 of cd fld "Coords" of cd origin into lat
  if (it=trunc(dayUT) and the optionkey is up) and not force then
    put line 5 of fld Pos into dra
    put line 6 of fld Pos into dec
    put line 3 of fld rise into arg
  else
    set cursor to 1002
    if short name of this cd is "Moon" then
      -- Moon calcs from A.A.
      put ((last word of line 1 of fld JD)-2451545)/36525 into t
      moonpos
    else
      put trunc(dayUT) into line 3 of fld UT
      put (dayUT+((the seconds-daySecs)/3600+DSTcheck())/24-1)/183-1 into x
      put 0 into a
      put 0 into b
      put num into i
      repeat until i=0
        set cursor to busy
        cheb a,b,word i+1 of fld "ra cheb"
        put xa into a
        put xb into b
        subtract 1 from i
      end repeat
      put xb into b2
      cheb a,b,word 1 of fld "ra cheb"
      put (((xa-b2)/2+48) mod 24) *15 into dra
      put dra/15 into decra
      put 0 into a
      put 0 into b
      put num into i
      repeat until i=0
        set cursor to busy
        cheb a,b,word i+1 of fld "dec cheb"
        put xa into a
        put xb into b
        subtract 1 from i
      end repeat
      put xb into b2
      cheb a,b,word 1 of fld "dec cheb"
      get (xa-b2)/2
      put it into dec
      if "Sun" is in short name of this cd then
        -- use -12 for twilight altitude
        get (-.20791-sind(lat)*sind(dec))/(cosd(lat)*cosd(dec))
        put abs(atan(sqrt(1-it*it)/it)) into ang
        if -.20791<sind(lat)*sind(dec) then put pi-ang into ang
        put ang/fac/15 into delta
        put (dra/15+(line 2 of fld UT)-line 2 of fld 2+24-DSTcheck()) mod 24 into arg
        get arg-delta
        put it into line 3 of cd fld twilight
        hm false,it
        ampm
        put "Twilight begins at "& h &":" & m && mode into line 1 of cd fld twilight
        get arg+delta
        put it into line 4 of cd fld twilight
        hm false,it
        ampm
        put "Twilight ends    at "& h &":" & m && mode into line 2 of cd fld twilight
      end if
    end if
    put dra into line 5 of fld Pos
    hm false,decra
    put short name of this cd &" R.A. = "& h &"h " & m &"m"into line 1 of fld Pos
    put dec into line 6 of fld Pos
    put empty into sign
    if dec<0 and dec>-1 then put "-" into sign
    if dec>0 then put "+" into sign
    hm true,dec
    put short name of this cd&" Dec.  = "&sign&h&"° "&m&"'" into line 2 of fld Pos
    get -sind(lat)*sind(dec)/cosd(lat)/cosd(dec)
    put atan(sqrt(1-it*it)/it) into ang
    put dec>0 into d1
    put lat>0 into d2
    if d1 is d2 then
      add pi to ang
    end if
    put ang/fac/15 into delta
    put dra/15+line 2 of fld UT-line 2 of fld ST+24-DSTcheck() into arg
    get (arg-delta) mod 24
    put arg into line 3 of fld rise
    put it into line 4 of fld rise
    hm false,it
    ampm
    if the short name of this cd ≠ "Moon" then put short name of this cd && "Rises at "& h &":" & m && mode into line 1 of fld rise
    get (arg+delta) mod 24
    put it into line 5 of fld rise
    hm false,it
    ampm
    if the short name of this cd ≠ "Moon" then put short name of this cd && "Sets  at "& h &":" & m && mode into line 2 of fld rise
    set cursor to 1001
  end if
  -- calc alt and az of object
  put ((360+15*(line 2 of fld ST)-dra) mod 360) into LHA
  put cosd(LHA)*sind(lat)-tand(dec)*cosd(lat) into den
  put round(atanq(den,sind(LHA))/fac) into temp
  put sind(lat)*sind(dec)+cosd(lat)*cosd(dec)*cosd(LHA) into sina
  if abs(sina)<1 then
    put round(atan(sina/(sqrt(1-sina*sina)))/fac) into alt
    if alt>0 then
      put "Az. = "& temp into line 3 of fld Pos
      put "Alt. = " & alt into line 4 of fld Pos
    else
      if temp>180
      then put "W" into tem
    else put "E" into tem
    put "below " & tem & " horizon" into line 3 of fld Pos
    put empty into line 4 of fld Pos
  end if
else
  beep
end if
set cursor to 1
end calc

on ampm
  global h,mode,intl
  if intl is empty then
    put h into h2
    if h>11 then
      subtract 12 from h
      put "PM" into mode
    else
      put "AM" into mode
    end if
    if h=0 then
      put 12 into h
    end if
  else
    put empty into mode
  end if
end ampm